home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / lib_itcl.tcl < prev    next >
Encoding:
Text File  |  1997-10-23  |  7.2 KB  |  234 lines
  1. ##############################################################################
  2. #
  3. # lib_itcl.tcl - itcl widget support library
  4. #
  5. # Copyright (C) 1996-1997 Stewart Allen
  6. #
  7. # This program is free software; you can redistribute it and/or
  8. # modify it under the terms of the GNU General Public License
  9. # as published by the Free Software Foundation; either version 2
  10. # of the License, or (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program; if not, write to the Free Software
  19. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. #
  21. # Architecture by Stewart Allen
  22. # Implementation by James Kramer usinge ideas from
  23. # Kenneth H. Cox <kcox@senteinc.com>
  24.  
  25. #
  26. # Initializes this library
  27. #
  28.  
  29. proc vTcl:widget:lib:lib_itcl {args} {
  30.     global vTcl
  31.     #
  32.     # see if we're running itclWish. if not, return
  33.     #
  34.     if {[catch {class itcltest { constructor {args} {}}}]} {
  35.         return
  36.     }
  37.  
  38.     # setup required variables
  39.     vTcl:lib_itcl:setup
  40.  
  41.     # add items to toolbar
  42.     foreach i {
  43.         entryfield spinint combobox
  44.     } {
  45.         set img_file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
  46.         if {![file exists $img_file]} {
  47.             set img_file [file join $vTcl(VTCL_HOME) images icon_tix_unknown.gif]
  48.         }
  49.         image create photo "ctl_$i" -file $img_file
  50.         vTcl:toolbar_add $i $i ctl_$i ""
  51.     }
  52.     # The Widget Browser needs images for all itcl classes.
  53.     # The images need to be called, e.g. ctl_itclNoteBookFrame.
  54.     # Don't put these in the toolbar, because they are not commands,
  55.     # only classes.
  56. }
  57.  
  58. proc vTcl:lib_itcl:setup {} {
  59.     global vTcl
  60.  
  61.     #
  62.     # additional attributes to set on insert
  63.     #
  64.     set vTcl(scrolledlistbox,insert)       "-labeltext {Label:} "
  65.     set vTcl(combobox,insert)       "-labeltext {Label:} "
  66.     set vTcl(entryfield,insert)       "-labeltext {Label:} "
  67.     set vTcl(spinint,insert)       "-labeltext {Label:} -range {0 10} -step 1"
  68.  
  69.     #
  70.     # add to procedure, var, bind regular expressions
  71.     #
  72. #    if {"$vTcl(bind,ignore)" != ""} {
  73. #        append vTcl(bind,ignore) "|tix"
  74. #    } else {
  75. #        append vTcl(bind,ignore) "tix"
  76. #    }
  77. #    append vTcl(proc,ignore) "|tix"
  78. #    append vTcl(var,ignore)  "|tix"
  79.         append vTcl(top,ignore,post) ".*shell\\.lwchildsite\\.efchildsite\\.popup"
  80.  
  81.     lappend vTcl(NoXResizeClasses) Combobox Spinint Entryfield
  82.     #
  83.     # add to valid class list
  84.     #
  85.     lappend vTcl(classes) \
  86.         Entryfield \
  87.         Spinint \
  88.         Combobox \
  89.                 Scrolledlistbox
  90.  
  91.     lappend vTcl(multclasses) \
  92.         Entryfield \
  93.         Spinint \
  94.         Combobox \
  95.                 Scrolledlistbox
  96.  
  97.         lappend vTcl(Combobox,nosubwidget) \
  98.                 shell \
  99.                 shell.label \
  100.                 shell.lwchildsite \
  101.                 shell.lwchildsite.entry \
  102.                 shell.lwchildsite.efchildsite \
  103.                 shell.lwchildsite.efchildsite.arrowBtn
  104.  
  105.         lappend vTcl(Entryfield,nosubwidget) \
  106.                 shell \
  107.                 shell.label \
  108.                 shell.labelmargin \
  109.                 shell.lwchildsite \
  110.                 shell.lwchildsite.entry
  111.  
  112.         lappend vTcl(Spinint,nosubwidget) \
  113.                 shell \
  114.                 shell.label \
  115.                 shell.lwchildsite \
  116.                 shell.lwchildsite.entry \
  117.                 shell.lwchildsite.efchildsite \
  118.                 shell.lwchildsite.efchildsite.arrowFrame \
  119.                 shell.lwchildsite.efchildsite.arrowFrame.uparrow \
  120.                 shell.lwchildsite.efchildsite.arrowFrame.downarrow        
  121.     #
  122.     # register additional options that might be on itcl widgets,
  123.     # and the option information that the Attribute Editor needs.
  124.     #
  125.     lappend vTcl(opt,list) \
  126.             -fixed \
  127.             -range \
  128.             -step \
  129.             -validate \
  130.             -labeltext \
  131.             -labelpos \
  132.             -labelfont \
  133.             -textfont \
  134.             -items \
  135.             -decrement \
  136.             -increment \
  137.             -listheight
  138.  
  139. #    set vTcl(opt,-plotbackground) { {Plot BgColor}    Colors   color   {} }
  140.     set vTcl(opt,-labelfont) { {Label Font}        {}       type    {} }
  141.     set vTcl(opt,-textfont) { {Text Font}        {}       type    {} }
  142.     set vTcl(opt,-labelpos) { {Label Pos}          {}       choice  {n ne e se s sw w nw center} }
  143.     set vTcl(opt,-fixed) { {Fixed}        longname type    {} }
  144.     set vTcl(opt,-validate)      { {Validate Cmd}          {}       command {}}
  145.     set vTcl(opt,-decrement)      { {Decrement Cmd}          {}       command {}}
  146.     set vTcl(opt,-increment)      { {Increment Cmd}          {}       command {}}
  147.     set vTcl(opt,-labeltext)      { Label               longname type    {} }
  148.     set vTcl(opt,-range)      { Range               longname type    {} }
  149.     set vTcl(opt,-items)      { Items               {}  command  {} }
  150. #    set vTcl(opt,-items)      { Items               longname type    {} }
  151.     set vTcl(opt,-step)      { Step               longname type    {} }
  152.     set vTcl(opt,-listheight)    { "List Height"         longname type    {} }
  153.     
  154.     #
  155.     # define dump procedures for widget types
  156.     #
  157.     set vTcl(Entryfield,dump_opt)         vTcl:lib_itcl:dump_widget_opt
  158.     set vTcl(Spinint,dump_opt)         vTcl:lib_itcl:dump_widget_opt
  159.     set vTcl(Combobox,dump_opt)         vTcl:lib_itcl:dump_combobox
  160.     set vTcl(Scrolledlistbox,dump_opt)             vTcl:lib_itcl:dump_widget_opt
  161.  
  162.     #
  163.     # define whether or not do dump children of a class
  164.     #
  165.     set vTcl(Entryfield,dump_children)         0
  166.     set vTcl(Spinint,dump_children)         0
  167.     set vTcl(Combobox,dump_children)         0
  168.     set vTcl(Scrolledlistbox,dump_children)         0
  169. }
  170.  
  171. #
  172. # individual widget commands executed after insert
  173. #
  174. proc vTcl:widget:graph:inscmd {target} {
  175.     return ""
  176. }
  177.  
  178. #
  179. # per-widget-class dump procedures
  180. #
  181.  
  182. # Utility proc.  Ignore color options (-background, etc.) based on
  183. # preference.
  184. #
  185. # returns:
  186. #   1 means save the option
  187. #   0 means don't save it
  188. proc vTcl:lib_itcl:save_option {opt} {
  189.     if [string match *::iwidgets* $opt] {
  190.         return 0
  191.     }
  192. #    puts "save_option '$opt'"
  193.     return 1
  194. }
  195.  
  196. # Utility proc.  Dump a itcl widget.
  197. # Differs from vTcl:dump_widget_opt in that it tries harder to avoid
  198. # dumping options that shouldn't really be dumped, e.g. -fg,-bg,-font.
  199. proc vTcl:lib_itcl:dump_widget_opt {target basename} {
  200.     global vTcl
  201.     set result ""
  202.     set class [vTcl:get_class $target]
  203.     set result "$vTcl(tab)[vTcl:lower_first $class] $basename"
  204.     set opt [$target configure]
  205.     set keep_opt ""
  206.     foreach e $opt {
  207.         if [vTcl:lib_itcl:save_option $e] {
  208.             lappend keep_opt $e
  209.         }
  210.     }
  211.     set p [vTcl:get_opts $keep_opt]
  212.     if {$p != ""} {
  213.         append result " \\\n[vTcl:clean_pairs $p]\n"
  214.     } else {
  215.         append result "\n"
  216.     }
  217.     append result [vTcl:dump_widget_bind $target $basename]
  218.     return $result
  219. }
  220.  
  221. # Utility proc.  Dump a itcl widget.
  222. # Differs from vTcl:dump_widget_opt in that it tries harder to avoid
  223. # dumping options that shouldn't really be dumped, e.g. -fg,-bg,-font.
  224. proc vTcl:lib_itcl:dump_combobox {target basename} {
  225.     global vTcl
  226.     $target configure -editable 1
  227.     set result [vTcl:lib_itcl:dump_widget_opt $target $basename]
  228.     $target configure -editable 0
  229.     return $result
  230. }
  231.  
  232.  
  233.  
  234.